Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-06/segue.exe/ALL_DEMO.PRG

Text File | 1991-10-28 | 6KB | 334 lines

*.............................................................................
*   Program Name: ALL_DEMO.PRG        Copyright: HRF Associates, Inc.
*   Date Created: 01/16/91             Language: Clipper
*   Time Created: 11:45:39               Author: Bob Fogle
*.............................................................................
PARAMETERS mSVC
mLASTCOLOR  = SETCOLOR()
mLASTSCREEN = SAVESCREEN(00,00,24,79)
mLASTCURROW = ROW()
mLASTCURCOL = COL()
NOCOLOR="W/N,N+/W,,,W+/N"
mPARAN='()'
end_flag = .F.
mCNT=.F.
SET wrap ON
SET message TO 23 center
byy=10
byylen=14
byywidth=10
msupno=0
IF FILE("DEMO.DBF")
sele 1
use demo
go bott
ENDI
LCHOICE=0

DO WHILE .T.
SETCOLOR(if(iscolor()=.F.,NOCOLOR,"BG+/B,B/W+,,,W+/B"))
CLEAR
xx=3
if msupno<>1
@  xx, 3 SAY "Select SEGUE API to demo:"
else
@  xx, 3 SAY "Select SEGUE SUPPLEMENT FUNCTION to demo:"
endi
xx=xx+2
DO CASE
  CASE mSVC=="BD"
    DO BD_DEMO
  CASE mSVC=="CT"
    DO CT_DEMO
  CASE mSVC=="DR"
    DO DR_DEMO
  CASE mSVC=="FL"
    DO FL_DEMO
  CASE mSVC=="FS"
    DO FS_DEMO
  CASE mSVC=="MG"
    DO MG_DEMO
  CASE mSVC=="PR"
    DO PR_DEMO
  CASE mSVC=="SZ"
    DO SZ_DEMO
  CASE mSVC=="TT"
    DO TT_DEMO
  CASE mSVC=="WE"
    DO WE_DEMO
  CASE mSVC=="BDsup"
    DO BDsup
  CASE mSVC=="CTsup"
    DO CTsup
  CASE mSVC=="DRsup"
    DO DRsup
  CASE mSVC=="FLsup"
    DO FLsup
  CASE mSVC=="FSsup"
    DO FSsup
  CASE mSVC=="MGsup"
    DO MGsup
  CASE mSVC=="PRsup"
    DO PRsup
  CASE mSVC=="SZsup"
    DO SZsup
  CASE mSVC=="TTsup"
    DO TTsup
  CASE mSVC=="WEsup"
    DO WEsup
ENDCASE

  IF end_flag
    @ mLASTCURROW-2,mLASTCURCOL
    RESTSCREEN(00,00,24,79,mLASTSCREEN)
    SETCOLOR(mLASTCOLOR)
    close all
    msupno=0
    RETURN
  ENDIF
ENDDO

PROCEDURE MDISP
yy=byy
yylen=byylen
yywidth=byywidth
@ 00,00 TO 24,79 DOUBLE
if msupno>1
@ 05,48 TO 18,77
@ 05,55 SAY " SEGUE SUPPLEMENT "
sbyy=50
sbxx=6
syylen=12
endi
msflag=.f.
for i=1 to bcnt
  @ xx,yy PROMPT mPROMPT[i] MESSAGE mAPI[i]
  xx=xx+1

  if msupno>1.and.i>=msupno-1
    if .not.msflag
    xx = sbxx
    yy = sbyy
    msflag=.t.
    endi
    if xx = sbxx+syylen
       xx = sbxx
       yy = yy+yywidth+1
    endi

  else
    if i=15
      xx=xx-yylen
      yy=yy+yywidth
    endi
    if i=29
      xx=xx-yylen
      yy=yy+yywidth
    endi
  endi

next
return

PROCEDURE INTRO
PUBLIC XX
CLEAR
xx=ROW()
xx=xx+1
if msupno=0  // NPRCHECK TO SEE WHERE SEGUE SUPPLEMENTS START
  @ xx, 0 SAY "Demo for "+mPROMPT[mCHOICE]+mPARAN+', '+mAPI[mCHOICE]+" API"
else
  @ xx, 0 SAY "Demo for "+mPROMPT[mCHOICE]+mPARAN+', '+mAPI[mCHOICE]+" FUNCTION"
endi
xx=xx+2
@ xx, 0
RETURN

PROCEDURE CLR
if xx=23
  xx=7
  if yy=0
    yy=yy+43
  else
    yy=0
    @ 23,0
    @ 23,0 say "Press any key to continue..."
    inkey(0)
    @ 7,51 clear to 23,79
  endi
endi
RETURN

PROCEDURE CLR2
if xx=23
  xx=5
  if yy=0
    yy=yy+43
  else
    yy=0
    @ 23,0
    @ 23,0 say "Press any key to continue..."
    inkey(0)
    @ 5,0 clear to 23,79
  endi
endi
RETURN

PROCEDURE CHKRTNUM
PARAMETERS rtn
IF rtn<0
IF rtn=-251.AND.mSVC<>"BD"
  @ 23,0 SAY ;
"Sorry, Novell did not include this service in this version of NetWare ... "
else
  ?"Error:", rtn
endi
ELSE
  @ 23,0 SAY "Successful ! ... Use SYSCON to check."
ENDIF
WAIT
RETURN

PROCEDURE CHKRTNUM1
PARAMETERS rtn
IF rtn<0
IF rtn=-251.AND.mSVC<>"BD"
  @ 23,0 SAY ;
"Sorry, Novell did not include this service in this version of NetWare ... "
else
  ?"Error:", rtn
endi
ELSE
  @ 23,0 SAY "Successful ! ...."
ENDIF
WAIT
RETURN

PROCEDURE CHKRTNUM2
PARAMETERS rtn
IF rtn<0
IF rtn=-251.AND.mSVC<>"BD"
  @ 23,0 SAY ;
"Sorry, Novell did not include this service in this version of NetWare ... "
else
  ?"Error:", rtn
  WAIT
  OK=.F.
endi
elseif mCNT
  ?"Count = ", LTRIM(STR(rtn))
  WAIT
  OK=.F.
ENDIF
RETURN

PROCEDURE CHKRTNUM3
PARAMETERS rtn
IF rtn<0
IF rtn=-251.AND.mSVC<>"BD"
  @ 23,0 SAY ;
"Sorry, Novell did not include this service in this version of NetWare ... "
else
  ?"Error:", rtn
  WAIT
  OK=.F.
endi
ENDIF
RETURN

PROCEDURE CHKRTNUM4
PARAMETERS rtn
IF rtn<0
IF rtn=-251.AND.mSVC<>"BD"
  @ 23,0 SAY ;
"Sorry, Novell did not include this service in this version of NetWare ... "
else
  ?"No, because:", rtn
endi
ELSE
  @ 23,0 SAY "Yes ! ...."
ENDIF
WAIT
RETURN

PROCEDURE CHKRTNUM5
PARAMETERS rtn
IF asc(rtn)<32 .or. asc(rtn)>100
IF asc(rtn)=251.AND.mSVC<>"BD"
  @ 23,0 SAY ;
"Sorry, Novell did not include this service in this version of NetWare ... "
else
  ?"Error:", -asc(rtn)
endi
ELSE
  @ 23,0 SAY rtn
ENDIF
WAIT
RETURN

PROCEDURE CHKRTNUM6
PARAMETERS rtn
if valtype(rtn)='N'
  IF rtn<0
    IF rtn=-251.AND.mSVC<>"BD"
      @ 23,0 SAY ;
"Sorry, Novell did not include this service in this version of NetWare ... "
    ELSE
      ? "Error:", rtn
    ENDI
  ELSE
    @ 23,0 SAY rtn
  ENDIF
ELSE
  @ 23,0 SAY rtn
ENDIF
WAIT
RETURN

PROCEDURE CHKRTNUM7
PARAMETERS rtn
IF rtn<0
IF rtn=-251.AND.mSVC<>"BD"
  @ 23,0 SAY ;
"Sorry, Novell did not include this service in this version of NetWare ... "
ELSE
  ? "Error: ", rtn
ENDIF
ELSE
  @ 23,0 SAY "Successful ! ... Use FILER to check."
ENDIF
WAIT
RETURN

PROCEDURE CHKRTNUM8
PARAMETERS rtn
IF if(valtype(rtn)='N',rtn,0)<0
  IF rtn=-251.AND.mSVC<>"BD"
  @ 23,0 SAY ;
"Sorry, Novell did not include this service in this version of NetWare ... "
  ELSE
  @ 23,0
  ?"Error:", rtn
  ENDIF
ELSE
  @ 23,0
  @ 23,0 SAY if(valtype(rtn)='N',TRANS(rtn,"@B ###,###,###,###"),rtn)
ENDIF
WAIT
RETURN

PROCEDURE CHKRTNUM10
PARAMETERS rtn
IF rtn<0
IF rtn=-251.AND.mSVC<>"BD"
  @ 23,0 SAY ;
"Sorry, Novell did not include this service in this version of NetWare ... "
else
  ?"Error:", rtn
endi
ELSE
  @ 23,0 SAY "Successful ! ... Use SETTTS.EXE to check."
ENDIF
WAIT
RETURN